home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / TEST / COROUTIN.M < prev    next >
Encoding:
Text File  |  1990-06-16  |  18.2 KB  |  719 lines
  1. MODULE Coroutin;
  2.  
  3. (*$E MOS *)
  4. IMPORT TOSIO;
  5. FROM InOut IMPORT KeyPressed, WriteString, WriteLn;
  6.  
  7. FROM SYSTEM IMPORT ASSEMBLER;
  8. FROM SYSTEM IMPORT ADDRESS, LISTEN, TRANSFER, IOTRANSFER, NEWPROCESS, ADR;
  9.  
  10. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  11.  
  12. FROM SysInfo IMPORT UseStackFrame;
  13.  
  14. FROM RandomGen IMPORT RandomCard;
  15.  
  16. IMPORT MOSGlobals, PrgCtrl; (* nur f. lokales Modul *)
  17.  
  18.  
  19. (*$L-*)
  20.  
  21. CONST   DftSF = $0010;
  22.         rtsCode = $4E75;
  23.  
  24. VAR useSF: BOOLEAN;
  25.  
  26. PROCEDURE BadReturn;  (* RTS aus CoRoutine anmeckern *)
  27.   BEGIN
  28.     ASSEMBLER
  29.         TRAP    #6
  30.         DC.W    -15-$6000       ; kein cont, scan prev
  31.     END
  32.   END BadReturn;
  33.  
  34. (*
  35.    Transferdaten beim Usermode:
  36.         2  Byte - 0: zeigt Usermode an / 1: Vektor zus. restaurieren
  37.         4  Byte - PC
  38.         2  Byte - SR
  39.         4  Byte - A6
  40.         56 Byte - D0-A5
  41.       { 60 Byte - FP3-FP7 }  (* wenn SwitchFPUContext = TRUE *)
  42.  
  43.    Transferdaten beim Supervisormode:
  44.         2  Byte - $FFxx, zeigt Supervisormode an
  45.         4  Byte - USP
  46.         60 Byte - D0-A6
  47.         4  Byte - Dummy
  48.         2  Byte - SR
  49.         4  Byte - PC
  50.       { 60 Byte - FP3-FP7 }  (* wenn SwitchFPUContext = TRUE *)
  51. *)
  52.  
  53. (* Kennung:      Zustand:
  54.     0             Normal u. Exc-Rückkehr - Usermode
  55.     1             Warten auf Exc - Usermode, Vektor restaurieren
  56.     $FF           Exc-Rückkehr - Supervisormode
  57. *)
  58.  
  59. PROCEDURE @NEWP ( p:PROC; a:ADDRESS; n:LONGCARD; VAR prc:ADDRESS );
  60.   BEGIN
  61.     ASSEMBLER
  62.         LINK    A5,#0
  63.         
  64.         MOVE.L  -(A3),A1        ; 'prc'
  65.         MOVE.L  -(A3),A0        ; SIZE (workspace)
  66.         MOVE.L  A0,D1
  67.         BCLR    #0,D1
  68.         MOVE.L  -(A3),D0        ; ADR (workspace)
  69.         ADDQ.L  #1,D0
  70.         BCLR    #0,D0
  71.         ADDA.L  D0,A0           ; ENDADR (workspace)
  72.         MOVE.L  -(A3),D2        ; ADR (procedure)
  73.         CMPI.L  #90,D1          ; ist workspace groß genug ?
  74.         BCC     wspOk
  75.         
  76.         TRAP    #6
  77.         DC.W    -10-$4000       ; 'out of stack'
  78.         UNLK    A5
  79.         RTS
  80.         
  81.       wspOk:
  82.         MOVEM.L A3/A5,-(A7)
  83.         
  84.         MOVE.L  D0,A3
  85.         
  86.         MOVE.L  D2,-(A0)         ;Adresse für scan
  87.         ADDQ.L  #2,(A0)          ;scan-Adr etwas vorsetzen
  88.         CLR.L   -(A0)            ;voriges A5
  89.         MOVE.L  A0,A5            ;für UNLK in backScan()
  90.         MOVE.L  #BadReturn,-(A0) ;Fehlerbehandlung bei RTS aus Coroutine
  91.         
  92.         MOVEM.L D0-A5,-(A0)      ; Bis auf A3,A5 nur Dummy-Werte
  93.         MOVE.L  A6,-(A0)
  94.         MOVE.W  SR,-(A0)
  95.         MOVE.L  D2,-(A0)
  96.         CLR.W   -(A0)
  97.         
  98.         ; nun den SP in 'prc' ablegen
  99.         MOVE.L  A0,(A1)
  100.         
  101.         MOVEM.L (A7)+,A3/A5
  102.         UNLK    A5
  103.     END
  104.   END @NEWP;
  105.  
  106. PROCEDURE @TRAN ( VAR source,dest:ADDRESS );  (* Transfer *)
  107.   BEGIN
  108.     ASSEMBLER
  109.         ; Aufruf erfolgt immer im Usermode, der zu startende Prozeß
  110.         ; kann in beiden Modi ablaufen
  111.         
  112.         CLR.L   -(A7)
  113.         MOVE    #$20,-(A7)
  114.         TRAP    #1
  115.         ADDQ.L  #6,A7
  116.         MOVE.L  A7,A0
  117.         MOVE.L  D0,A7
  118.         
  119.         MOVE.L  -(A3),A2        ; dest
  120.         MOVE.L  -(A3),A1        ; source
  121.         MOVE    SR,D2
  122.         ANDI    #$CFFF,D2
  123.         
  124.         MOVE    #$2700,SR       ; keine Interrupts !
  125.         
  126.         ; aktiven Prozeß beenden
  127.         MOVE.L  (A0)+,D0        ; Rücksprungadr. hinter TRANSFER
  128.         MOVEM.L D0-A5,-(A0)
  129.         MOVE.L  A6,-(A0)
  130.         MOVE.W  D2,-(A0)
  131.         MOVE.L  D0,-(A0)
  132.         CLR.W   -(A0)
  133.         
  134.         MOVE.L  (A2),D0         ; zuerst retten, falls A1=A2
  135.         MOVE.L  A0,(A1)
  136.         MOVE.L  D0,A6
  137.         
  138.         ; neuen Prozeß starten
  139.         TST.W   (A6)+
  140.         BEQ     stUsr
  141.         BMI     stSup
  142.         
  143.         ; starte Usermode, vorher Vektor restaurieren
  144.         MOVE.L  (A6)+,D0        ; alter Vektor
  145.         MOVE.L  4+2+4+4(A6),A0  ; D1: Vektoradr.
  146.         MOVE.L  D0,(A0)
  147.         TST     useSF
  148.         BEQ     no20
  149.         MOVE    #DftSF,-(A7)
  150. no20:
  151.         MOVE.L  (A6)+,-(A7)     ; PC
  152.         MOVE.W  (A6)+,-(A7)     ; SR
  153.         MOVE.L  (A6)+,-(A7)     ; A6
  154.         MOVEM.L (A6)+,D0-A5
  155.         MOVE.L  A6,USP
  156.         MOVE.L  (A7)+,A6
  157.         RTE
  158.         
  159. stUsr:  ; starte Usermode
  160.         TST     useSF
  161.         BEQ     no20b
  162.         MOVE    #DftSF,-(A7)
  163. no20b:
  164.         MOVE.L  (A6)+,-(A7)     ; PC
  165.         MOVE.W  (A6)+,-(A7)     ; SR
  166.         MOVE.L  (A6)+,-(A7)     ; A6
  167.         MOVEM.L (A6)+,D0-A5
  168.         MOVE.L  A6,USP
  169.         MOVE.L  (A7)+,A6
  170.         RTE
  171.         
  172. stSup:  ; starte Supervisormode
  173.         MOVE.L  A6,A7
  174.         MOVE.L  (A7)+,A0
  175.         MOVE.L  A0,USP
  176.         MOVEM.L (A7)+,D0-A6
  177.         ADDQ.L  #4,A7
  178.         TST     useSF
  179.         BEQ     no20c
  180.         MOVE.W  (A7),-(A7)
  181.         MOVE.L  4(A7),2(A7)
  182.         MOVE    #DftSF,6(A7)
  183. no20c:
  184.         RTE
  185.     END
  186.   END @TRAN;
  187.  
  188. PROCEDURE @LSTN;
  189.   BEGIN
  190.     ASSEMBLER
  191.         PEA     P(PC)
  192.         MOVE    #38,-(A7)
  193.         TRAP    #14
  194.         ADDQ.L  #6,A7
  195.         RTS
  196.      P: MOVE    SR,D1
  197.         MOVE    D1,D0
  198.         ANDI    #$0700,D0
  199.         BEQ     ok
  200.         MOVE    D1,D0
  201.         SUBI    #$0100,D0
  202.         MOVE    D0,SR
  203.         NOP
  204.         NOP
  205.       ok:
  206.         MOVE    D1,SR
  207.     END
  208.   END @LSTN;
  209.  
  210. PROCEDURE hdlExc;
  211.   (* Für IOTRANSFER-Auslösungen per Exception *)
  212.   BEGIN
  213.     ASSEMBLER
  214.         ; Der Aufruf kann aus beiden Modi kommen, der zu startende
  215.         ; Prozeß ist immer im Usermode
  216.         
  217.         MOVE    #$2700,SR       ; keine Interrupts !
  218.         
  219.         BTST.B  #5,4(A7)        ; aus welchem mode ?
  220.         BNE     frSup
  221.         
  222.         ; Entry aus User mode
  223.         
  224.         ; Daten auf den USP retten
  225.         MOVE.L  A6,-(A7)
  226.         MOVE.L  USP,A6
  227.         MOVEM.L D0-A5,-(A6)
  228.         MOVE.L  (A7)+,-(A6)
  229.         MOVE.L  (A7)+,A0        ; ^Transfer-Daten
  230.         MOVE    (A7)+,-(A6)     ; SR
  231.         MOVE.L  (A7)+,-(A6)     ; PC
  232.         CLR.W   -(A6)
  233.         
  234.         ; A0 zeigt auf:
  235.         ; 2  Byte - 1, zeigt IOTR an
  236.         ; 4  Byte - alter Exc-Vektor
  237.         ; 4  Byte - PC
  238.         ; 2  Byte - SR
  239.         ; 4  Byte - A6
  240.         ; 56 Byte - D0-A5
  241.         
  242.         MOVE.L  2+4+4+2+4+32+8(A0),A2  ; A2: alter dest^
  243.         MOVE.L  A6,(A2)
  244.         
  245.         MOVE.L  2+4+4+2+4+4(A0),A3  ; D1: Vektoradr.
  246.         LEA     2(A0),A6
  247.         MOVE.L  (A6)+,(A3)      ; alten Vektor restaurieren
  248.         TST     useSF
  249.         BEQ     no20d
  250.         MOVE    #DftSF,-(A7)
  251. no20d:
  252.         MOVE.L  (A6)+,-(A7)     ; PC
  253.         MOVE.W  (A6)+,-(A7)     ; SR
  254.         MOVE.L  (A6)+,-(A7)     ; A6
  255.         MOVEM.L (A6)+,D0-A5
  256.         MOVE.L  A6,USP
  257.         MOVE.L  (A7)+,A6
  258.         RTE
  259.         
  260. frSup:  ; Entry aus Supervisor mode
  261.         
  262.         ; Daten auf den USP retten
  263.         MOVEM.L D0-A6,-(A7)
  264.         MOVE.L  USP,A6
  265.         MOVE.L  A6,-(A7)
  266.         ST.B    -(A7)
  267.         
  268.         MOVE.L  2+4+60(A7),A0         ; ^Transfer-Daten
  269.         
  270.         ; A0: (s.o.)
  271.         
  272.         MOVE.L  2+4+4+2+4+32+8(A0),A2   ; A2: alter dest^
  273.         MOVE.L  A7,(A2)
  274.         
  275.         MOVE.L  2+4+4+2+4+4(A0),A3  ; D1: Vektoradr.
  276.         LEA     2(A0),A6
  277.         MOVE.L  (A6)+,(A3)      ; alten Vektor restaurieren
  278.         TST     useSF
  279.         BEQ     no20e
  280.         MOVE    #DftSF,-(A7)
  281. no20e:
  282.         MOVE.L  (A6)+,-(A7)     ; PC
  283.         MOVE.W  (A6)+,-(A7)     ; SR
  284.         MOVE.L  (A6)+,-(A7)     ; A6
  285.         MOVEM.L (A6)+,D0-A5
  286.         MOVE.L  A6,USP
  287.         MOVE.L  (A7)+,A6
  288.         RTE
  289.     END
  290.   END hdlExc;
  291.  
  292. PROCEDURE hdlCall;
  293.   (* Für IOTRANSFER-Auslösungen per JSR *)
  294.   BEGIN
  295.     ASSEMBLER
  296.         ; Der Aufruf kann aus beiden Modi kommen, der zu startende
  297.         ; Prozeß ist immer im Usermode
  298.         
  299.         MOVE.L  D1,-(A7)
  300.         
  301.         MOVEM.L D0/D2/A0-A2,-(A7)
  302.         MOVEQ   #1,D0
  303.         MOVE.L  D0,-(A7)
  304.         MOVE    #$20,-(A7)
  305.         TRAP    #1
  306.         TST.W   D0
  307.         BNE     frSup
  308.         
  309.         ; Entry aus User mode
  310.         
  311.         MOVE.W  D0,4(A7)
  312.         TRAP    #1
  313.         ADDQ.L  #6,A7
  314.         MOVE.L  A7,USP
  315.         MOVE.L  D0,A7
  316.         MOVEM.L (A7)+,D0/D2/A0-A2
  317.         
  318.         MOVE    SR,D1
  319.         ANDI    #$CFFF,D1
  320.         
  321.         ;BREAK
  322.         MOVE    #$2700,SR       ; keine Interrupts !
  323.         
  324.         ; Aktiven Prozeß beenden, Daten auf den USP retten
  325.         ; auf USP stehen noch: D1.L, ^Dest-Transfer-Daten, PC.L
  326.         MOVE.L  A0,-(A7)
  327.         MOVE.L  USP,A0
  328.         MOVE.L  (A0)+,-(A7)     ; D1 retten
  329.         MOVE.L  (A0)+,-(A7)     ; ^Transfer-Daten
  330.         MOVE.L  (A0)+,-(A7)     ; PC retten
  331.         MOVEM.L D0-A5,-(A0)
  332.         MOVE.L  A6,-(A0)
  333.         MOVE.W  D1,-(A0)        ; SR
  334.         MOVE.L  (A7)+,-(A0)     ; PC
  335.         MOVE.L  (A7)+,14(A0)    ; D1 in Transfer-Daten ablegen
  336.         MOVE.L  (A7)+,A1        ; ^Transfer-Daten
  337.         MOVE.L  (A7)+,42(A0)    ; A0 in Transfer-Daten ablegen
  338.         CLR.W   -(A0)
  339.         
  340.         ; A1 zeigt auf:
  341.         ; 2  Byte - 1, zeigt IOTR an
  342.         ; 4  Byte - alter Exc-Vektor
  343.         ; 4  Byte - PC
  344.         ; 2  Byte - SR
  345.         ; 4  Byte - A6
  346.         ; 56 Byte - D0-A5
  347.         
  348.         MOVE.L  2+4+4+2+4+32+8(A1),A2  ; A2: alter dest^
  349.         MOVE.L  A6,(A2)
  350.         
  351.         MOVE.L  2+4+4+2+4+4(A1),A3  ; D1: Vektoradr.
  352.         LEA     2(A1),A6
  353.         MOVE.L  (A6)+,(A3)      ; alten Vektor restaurieren
  354.         TST     useSF
  355.         BEQ     no20f
  356.         MOVE    #DftSF,-(A7)
  357. no20f:
  358.         MOVE.L  (A6)+,-(A7)     ; PC
  359.         MOVE.W  (A6)+,-(A7)     ; SR
  360.         MOVE.L  (A6)+,-(A7)     ; A6
  361.         MOVEM.L (A6)+,D0-A5
  362.         MOVE.L  A6,USP
  363.         MOVE.L  (A7)+,A6
  364.         RTE
  365.         
  366. frSup:  ; Entry aus Supervisor mode
  367.         
  368.         ADDQ.L  #6,A7
  369.         MOVEM.L (A7)+,D0/D2/A0-A2
  370.         
  371.         MOVE.L  (A7),D1
  372.         ADDQ.L  #2,A7
  373.         MOVE.L  2(A7),(A7)      ; ^Transfer-Daten 2 Byte tiefer
  374.         MOVE    SR,4(A7)        ; SR darüber
  375.         
  376.         ;BREAK
  377.         MOVE    #$2700,SR       ; keine Interrupts !
  378.         
  379.         ; aktiven Prozeß beenden, Daten auf den USP retten
  380.         MOVEM.L D0-A6,-(A7)
  381.         MOVE.L  USP,A0
  382.         MOVE.L  A0,-(A7)
  383.         ST.B    -(A7)
  384.         
  385.         MOVE.L  2+4+60(A7),A0         ; ^Transfer-Daten
  386.         
  387.         ; A0: (s.o.)
  388.         
  389.         MOVE.L  2+4+4+2+4+32+8(A0),A2   ; A2: alter dest^
  390.         MOVE.L  A7,(A2)
  391.         
  392.         MOVE.L  2+4+4+2+4+4(A0),A3  ; D1: Vektoradr.
  393.         LEA     2(A0),A6
  394.         MOVE.L  (A6)+,(A3)      ; alten Vektor restaurieren
  395.         TST     useSF
  396.         BEQ     no20g
  397.         MOVE    #DftSF,-(A7)
  398. no20g:
  399.         MOVE.L  (A6)+,-(A7)     ; PC
  400.         MOVE.W  (A6)+,-(A7)     ; SR
  401.         MOVE.L  (A6)+,-(A7)     ; A6
  402.         MOVEM.L (A6)+,D0-A5
  403.         MOVE.L  A6,USP
  404.         MOVE.L  (A7)+,A6
  405.         RTE
  406.     END
  407.   END hdlCall;
  408.  
  409.  
  410. PROCEDURE @IOTR ( VAR source,dest:ADDRESS; vecAddr:ADDRESS );
  411.   CONST JSRInstr = $4EB9;
  412.   BEGIN
  413.     ASSEMBLER
  414.         ; Aufruf erfolgt immer im Usermode, der zu startende Prozeß
  415.         ; kann in beiden Modi ablaufen
  416.         
  417.         CLR.L   -(A7)
  418.         MOVE    #$20,-(A7)
  419.         TRAP    #1
  420.         ADDQ.L  #6,A7
  421.         MOVE.L  A7,A0
  422.         MOVE.L  D0,A7
  423.         
  424.         MOVE.L  -(A3),D1        ; vector
  425.         MOVE.L  -(A3),A2        ; dest
  426.         MOVE.L  -(A3),A1        ; source
  427.         MOVE    SR,D2
  428.         ANDI    #$CFFF,D2
  429.         
  430.         MOVE    #$2700,SR       ; keine Interrupts !
  431.         
  432.         ; Daten für 'hdlExc' und 'hdlCall':
  433.         ; 2  Byte - 1, zeigt IOTR an
  434.         ; 4  Byte - alter Exc-Vektor
  435.         ; 4  Byte - PC
  436.         ; 2  Byte - SR
  437.         ; 4  Byte - A6
  438.         ; 56 Byte - D0-A5
  439.         
  440.         ; ③aktiven Prozeß beenden④
  441.         MOVE.L  (A0)+,D0        ; Rücksprungadr. hinter IOTRANSFER
  442.         MOVEM.L D0-A5,-(A0)
  443.         MOVE.L  A6,-(A0)
  444.         MOVE.W  D2,-(A0)
  445.         MOVE.L  D0,-(A0)
  446.         
  447.         MOVE.L  D1,A3
  448.         MOVE.L  (A3),-(A0)      ; alten vektor retten
  449.         
  450.         MOVE    #1,-(A0)
  451.         
  452.         MOVE.L  (A2),D0         ; zuerst retten, falls A1=A2
  453.         MOVE.L  A0,(A1)
  454.         MOVE.L  D0,A6
  455.         
  456.         CMPA.W  #$400,A3
  457.         BCS     isExc
  458.         MOVE.L  #hdlCall,-(A0)
  459.         BRA     cont0
  460. isExc   MOVE.L  #hdlExc,-(A0)
  461. cont0   MOVE    #JSRInstr,-(A0)
  462.         
  463.         MOVE.L  A0,(A3)         ; neuen vektor auf 'JSR hdlExc/hdlCall'
  464.         
  465.         ; ③neuen Prozeß starten④
  466.         TST.W   (A6)+
  467.         BEQ     stUsr
  468.         BMI     stSup
  469.         
  470.         ; starte Usermode, vorher Vektor restaurieren
  471.         MOVE.L  (A6)+,D0        ; alter Vektor
  472.         MOVE.L  4+2+4+4(A6),A0  ; D1: Vektoradr.
  473.         MOVE.L  D0,(A0)
  474.         TST     useSF
  475.         BEQ     no20h
  476.         MOVE    #DftSF,-(A7)
  477. no20h:
  478.         MOVE.L  (A6)+,-(A7)     ; PC
  479.         MOVE.W  (A6)+,-(A7)     ; SR
  480.         MOVE.L  (A6)+,-(A7)     ; A6
  481.         MOVEM.L (A6)+,D0-A5
  482.         MOVE.L  A6,USP
  483.         MOVE.L  (A7)+,A6
  484.         RTE
  485.         
  486. stUsr:  ; starte Usermode
  487.         TST     useSF
  488.         BEQ     no20i
  489.         MOVE    #DftSF,-(A7)
  490. no20i:
  491.         MOVE.L  (A6)+,-(A7)     ; PC
  492.         MOVE.W  (A6)+,-(A7)     ; SR
  493.         MOVE.L  (A6)+,-(A7)     ; A6
  494.         MOVEM.L (A6)+,D0-A5
  495.         MOVE.L  A6,USP
  496.         MOVE.L  (A7)+,A6
  497.         RTE
  498.         
  499. stSup:  ; starte Supervisormode
  500.         MOVE.L  A6,A7
  501.         MOVE.L  (A7)+,A0
  502.         MOVE.L  A0,USP
  503.         MOVEM.L (A7)+,D0-A6
  504.         ADDQ.L  #4,A7
  505.         TST     useSF
  506.         BEQ     no20j
  507.         MOVE.W  (A7),-(A7)
  508.         MOVE.L  4(A7),2(A7)
  509.         MOVE    #DftSF,6(A7)
  510. no20j:
  511.         RTE
  512.     END
  513.   END @IOTR;
  514.  
  515.  
  516. PROCEDURE @IOCA ( vecAddr:ADDRESS );
  517.   BEGIN
  518.     ASSEMBLER
  519.         CMPI.L  #$400,-(A3)
  520.         BCS     isExc
  521.         MOVEM.L D3-D7/A3-A6,-(A7)
  522.         CLR.L   -(A7)
  523.         MOVE    #$20,-(A7)
  524.         TRAP    #1
  525.         ADDQ.L  #6,A7
  526.         MOVE.L  A7,USP
  527.         MOVE.L  D0,A7
  528.         MOVE.L  (A3),A1
  529.         MOVE.L  (A1),A1
  530.         JSR     (A1)
  531.         ANDI    #$CFFF,SR
  532.         MOVEM.L (A7)+,D3-D7/A3-A6
  533.         RTS
  534.       isExc:
  535.         CLR.L   -(A7)
  536.         MOVE    #$20,-(A7)
  537.         TRAP    #1
  538.         ADDQ.L  #6,A7
  539.         MOVE.L  (A7)+,A2
  540.         MOVE    SR,D1
  541.         ANDI    #$CFFF,D1
  542.         MOVE.L  A7,USP
  543.         MOVE.L  D0,A7
  544.         MOVE.L  (A3),A1
  545.         MOVE.L  (A1),A1
  546.         TST     useSF
  547.         BEQ     no20k
  548.         MOVE    #DftSF,-(A7)
  549. no20k:
  550.         MOVE.L  A2,-(A7)
  551.         MOVE    D1,-(A7)
  552.         JMP     (A1)            ; rettet sicher alle Register
  553.     END
  554.   END @IOCA;
  555.  
  556.  
  557. PROCEDURE @PRIO;  (* Set Interrupt Priority *)
  558.   BEGIN
  559.     (* IR-level in D1, auf Bitpos. wie SR; D0, D2 nicht verändern ! *);
  560.     ASSEMBLER
  561.         MOVE.L  D2,-(A7)
  562.         MOVE.L  D0,-(A7)
  563.         MOVE.W  D1,-(A7)
  564.         CLR.L   -(A7)
  565.         MOVE    #$20,-(A7)
  566.         TRAP    #1
  567.         ADDQ.L  #6,A7
  568.         MOVE.W  (A7)+,D1
  569.         MOVE.L  A7,USP
  570.         MOVE.L  D0,A7
  571.         MOVE    SR,D0
  572.         ANDI    #$F0FF,D0
  573.         ANDI    #$0F00,D1
  574.         OR      D1,D0
  575.         MOVE    D0,SR
  576.         MOVE.L  (A7)+,D0
  577.         MOVE.L  (A7)+,D2
  578.     END
  579.   END @PRIO;
  580.  
  581. (*$L+*)
  582.  
  583.  
  584. MODULE IR [5];
  585.  
  586.   (*
  587.    * Lokales Modul, das sich in VBL-Vektor installiert.
  588.    * Dadurch wird die Routine 'serveProc' regelmäßig vom GEMDOS
  589.    * aufgerufen und setzt nach jeweils einer bestimmten Anzahl
  590.    * von Aufrufen eine Variable ('Key') auf TRUE.
  591.    *)
  592.  
  593.   IMPORT TRANSFER, IOTRANSFER, NEWPROCESS, ADDRESS, ADR, LISTEN;
  594.  
  595.   FROM PrgCtrl IMPORT CatchProcessTerm, TermCarrier;
  596.  
  597.   FROM MOSGlobals IMPORT MemArea;
  598.  
  599.   EXPORT Key;
  600.  
  601.   VAR main, server: ADDRESS;
  602.       stack: ARRAY [1..800] OF CARDINAL;
  603.       terminate, Key: BOOLEAN;
  604.  
  605.   PROCEDURE serveProc;
  606.     VAR i: CARDINAL;
  607.     BEGIN
  608.       i:= 0;
  609.       LOOP
  610.         IOTRANSFER (server, main, $4DEL);  (* VBL-Queue *)
  611.         IF terminate THEN
  612.           TRANSFER (server, main);
  613.         END;
  614.         INC (i);
  615.         IF i > 50 THEN
  616.           Key:= TRUE;
  617.           i:= 0
  618.         END
  619.       END
  620.     END serveProc;
  621.   
  622.   PROCEDURE terminateIR;
  623.     BEGIN
  624.       terminate:= TRUE;
  625.       TRANSFER (main, server)
  626.     END terminateIR;
  627.  
  628.   VAR carrier: TermCarrier;
  629.       wsp: MemArea;
  630.  
  631.   BEGIN
  632.     Key:= FALSE;
  633.     terminate:= FALSE;
  634.  
  635.     (*
  636.      * Prozeß einrichten und starten
  637.      *)
  638.     NEWPROCESS (serveProc, ADR (stack), SIZE (stack), server);
  639.     TRANSFER (main, server);
  640.  
  641.     (*
  642.      * Die Prozedur 'terminateIR' soll dafür sorgen, daß bei
  643.      * Programmende der IOTRANSFER-Zyklus beendet wird.
  644.      *)
  645.     wsp.bottom:= NIL;
  646.     CatchProcessTerm (carrier, terminateIR, wsp);
  647.   END IR;
  648.  
  649.  
  650. CONST StackSize = 2000L;
  651.  
  652. VAR a1, a2: ADDRESS;
  653.     Main, Ha, Tschi: ADDRESS;
  654.     Count: CARDINAL;
  655.     
  656. PROCEDURE schreibeHa;
  657.   VAR l:LONGCARD;
  658.   BEGIN
  659.     LOOP
  660.       IF RandomCard (1,5) # 5 THEN
  661.         WriteString (" Ha ");
  662.         FOR l:= 1L TO 3000L DO END
  663.       ELSE
  664.         IF Key THEN
  665.           Key:= FALSE;
  666.           WriteString (" <Key> ")
  667.         END;
  668.         TRANSFER (Ha, Tschi); (* direkter Transfer auf 'Tschi' *)
  669.         ASSEMBLER
  670.           TRAP #0             (* indirekter Transfer über TRAP #0 -> 'Tschi' *)
  671.         END;
  672.         WriteLn;
  673.       END;
  674.       IF Count >= 50 THEN
  675.         TRANSFER (Ha, Main);  (* Ende *)
  676.       END
  677.     END
  678.   END schreibeHa;
  679.  
  680. PROCEDURE schreibeTschi;
  681.   (*
  682.    * Durch das folgende Verlassen dieser Coroutine über 'IOTRANSFER'
  683.    * statt 'TRANSFER' kann sie sowohl durch einen TRANSFER auf sie
  684.    * zurück als auch über IO-Kanal (in diesem Fall 'TRAP #0') wieder
  685.    * aktiviert werden.
  686.    *)
  687.   BEGIN
  688.     LOOP
  689.       WriteString (" Tschi ");
  690.       INC (Count);
  691.       IOTRANSFER (Tschi, Ha, $80L);  (* Installation auf TRAP #0 *)
  692.     END;
  693.   END schreibeTschi;
  694.  
  695. BEGIN
  696.   useSF:= UseStackFrame ();
  697.   ALLOCATE (a1, StackSize);
  698.   ALLOCATE (a2, StackSize);
  699.   NEWPROCESS (schreibeHa, a1, StackSize, Ha);
  700.   NEWPROCESS (schreibeTschi, a2, StackSize, Tschi);
  701.   Count:= 0;
  702.   (*
  703.    * Nun niesen wir ein paarmal...
  704.    *)
  705.   TRANSFER (Main, Ha);
  706.   (*
  707.    * Danach warten wir auf einen Tastendruck, währenddessen weiterhin
  708.    * im VBL-Interrupt 'Key' zyklisch gesetzt wird.
  709.    *)
  710.   WHILE NOT KeyPressed () DO
  711.     IF Key THEN
  712.       Key:= FALSE;
  713.       WriteString (" <Key> ")
  714.     END
  715.   END;
  716.   DEALLOCATE (a1, StackSize);
  717.   DEALLOCATE (a2, StackSize);
  718. END Coroutin.
  719.